Trajectory plots
- Fan displays 50/80/95% confidence intervals
- Black line (with dots) is reported deaths
- Blue line (without dots) is the “corrected” deaths
# Grab corrected data
corrected <- suppressMessages(
covidcast::covidcast_signal(
state_forecaster_signals$data_source[1],
state_forecaster_signals$signal[1],
start_day = ymd(today) - days(x = corrections_lookback),
end_day = forecast_date,
geo_type = "state")) %>%
state_corrector()
corrected <- corrected[[1]]
# setup the plot and join corrections to the truth
pd <- evalcast:::setup_plot_trajectory(
antelope, geo_type = "state",
start_day = lubridate::ymd(today) - lubridate::days(x = corrections_lookback),
end_day = forecast_date,)
pd$truth_df <- left_join(
pd$truth_df, corrected,
by = c("geo_value" = "geo_value", "target_end_date" = "time_value")) %>%
filter(target_end_date >= ymd(today) - days(x = qa_lookback))
g <- ggplot(pd$truth_df, mapping = aes(x = target_end_date))
# build the fan
g <- g + geom_ribbon(
data = pd$quantiles_df,
mapping = aes(ymin = lower, ymax = upper, fill = interval)) +
scale_fill_brewer(palette = "Blues")
# line layer
g <- g +
geom_line(aes(y = .data$value.y), color = "#3182BD") + # corrected
geom_line(aes(y = .data$value.x)) + # reported
geom_line(data = pd$points_df,
mapping = aes(y = .data$value),
color = "orange", size = 1) +
geom_point(aes(y = .data$value.x)) + # reported gets dots
geom_point(data = pd$points_df,
mapping = aes(y = .data$value),
color = "orange", size = 3)
g + theme_bw(base_size = 20) +
facet_wrap(~geo_value, scales = "free_y", ncol = 5) +
theme(legend.position = "none") + ylab("") + xlab("")
Compare to hub
- We grab two hub forecasts, the ensemble and
## Fetched day 2021-12-01 to 2022-01-13: num_entries = 2376
